'##################################################
'###  Top Level (Get root Path from system env)
'##################################################
function GetEnv(envVarName)
	On Error Resume Next
	' 创建Shell对象并获取值
	Set WshShell = CreateObject("WScript.Shell")
	envValue = WshShell.Environment("PROCESS")(envVarName) ' 优先查找进程级变量

	' 如果未找到则尝试系统级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("SYSTEM")(envVarName)
	End If

	' 如果仍未找到则尝试用户级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("USER")(envVarName)
	End If

	' 检查结果并输出
	If Err.Number = 0 And envValue <> "" Then
		GetEnv=envValue
	Else
		GetEnv=""
	End If
end function

'##################################################
'##################################################
'##################################################
sub IncludeVbs(filepath)
	Dim fso, file, content
	Set fso = CreateObject("Scripting.FileSystemObject")
	' 读取functions.vbs的内容
	Set file = fso.OpenTextFile(filepath, 1) ' 1表示只读
	content = file.ReadAll
	file.Close
	' 将functions.vbs的内容载入全局作用域
	ExecuteGlobal content
end sub

'##################################################
'##################################################
'##################################################
dim hcfile
dim height
dim userLayerName:userLayerName="height_check"
Dim usrLyrObj
dim ncount :ncount=0
dim dict
set dict = createobject("scripting.dictionary")
Dim doc
main

dict.removeall
set dict = nothing
sub main()	
	'// REUSE
	envVarName ="EXP_SHORTCUTS_ROOT"
	dim root:root = GetEnv(envVarName)'"C:\MentorGraphics\2005EXP\SDD_HOME\pvtk\env\"
	if root ="" then 
		msgbox "please set env value (EXP_SHORTCUTS_ROOT = ?)"
		exit sub
	end if
	
	call IncludeVbs(root & "\skill_lib.vbs")
	
	Set doc = application.ActiveDocument
	If ValidateServer(doc) = 0 Then
	    msgbox "Server validation failed."
	    exit sub
	End If	
	
	'// TODO
	hcfile = root & "config\data\hc.txt"
	initDict
	

	doc.currentunit=4 'mm	
	doc.UnHighlightAll()
	
	

	call CheckUserlyr(userLayerName)
	dim cmp,cmps
	dim po,pos
	dim partnumber,cmpheight
	dim pref
	dim textStr
	dim orient:orient = 0

	set cmps = doc.components(0)
	for each cmp in cmps
		pref = ucase(left(cmp.name,1))
		on error resume next
		if cmp.side = 512 then
			partnumber = cmp.partname
			if dict.Exists(partnumber) = true then 						
			else
				if left(cmp.name,2)<>"TP" then
					set pos = cmp.PlacementOutlines
					for each po in pos	
						if po.height=0 then
							cmp.highlighted = true
							ncount = ncount +1		
						end if								
					next		
				end if				
			end if			
		end if				
	next	
	msgbox "Total : " & ncount

end sub

function reviseOrient(orient)
	dim new_orient:new_orient = orient
	if cint(orient) =0 then new_orient = 0
	if cint(orient) =180 then new_orient = 0
	if cint(orient) =90 then new_orient = 90
	if cint(orient) =270 then new_orient = 90
	if cint(orient) =45 then new_orient = 45
	if cint(orient) =135 then new_orient = -45
	if cint(orient) =225 then new_orient = 45
	reviseOrient = new_orient
end function
sub initDict()
	'on error resume next
	dim fso,fo,freadall
	Set fso = CreateObject("Scripting.FileSystemObject")
	if fso.fileExists(hcfile)=false then 
		msgbox hcfile & "file lost"
		set fso=nothing
		exit sub
	end if
	set fo = fso.opentextfile(hcfile,1)
	freadall= fo.readall
	fo.close
	set fo = nothing
	'msgbox freadall
	dim s,ls,i
	dim cs
	freadall = replace(freadall,chr(13),"")
	s= split(freadall,chr(10))
	ls = ubound(s)-lbound(s)+1
	for i=1 to ls-1
		if s(i)<>"" then
			cs = split(s(i),chr(9))
			'msgbox cs(0) & vbcrlf & cs(1)
			if ubound(cs)-lbound(cs)+1>1 then 
				'call dict.add("301201010000012","0.55")
				if dict.exists(cstr(trim(cs(0))))=false then call dict.add(cstr(trim(cs(0))),cstr(trim(cs(1))))		
				'msgbox dict("301201010000012")
			end if
			'exit for
		end if
	next
	'msgbox dict.count
	'msgbox dict.exists("301201010000012")
	set fso = nothing
end sub

sub CheckUserlyr(ulyr)
	MSGBOX "HERE"
	Set usrLyrObj = doc.FindUserLayer(ulyr)
	If usrLyrObj Is Nothing Then
		Set usrLyrObj = doc.SetupParameter.PutUserLayer(ulyr)
	Else
		doc.UserLayerTexts(, ulyr).Delete
	End If
	' TOP level
	Dim displCtrlObj
	Set displCtrlObj = doc.ActiveView.DisplayControl
	Dim dispCtrlGlobalObj
	Set dispCtrlGlobalObj = displCtrlObj.Global
	dispCtrlGlobalObj.UserLayerDisplayLevel(userLayerName) = epcbDisplayLevelTop
	dispCtrlGlobalObj.RaiseUserLayerDisplayLevel(userLayerName)
	displCtrlObj.UserLayer(userLayerName)=True
end sub

Function AddUsrMarks(userLayerName,oMarks,ObjX,ObjY,textOrientation)
    Dim ch
    Dim pen
    pen = 0
	ch = 0.254		
	Call doc.PutUserLayerText(oMarks,ObjX,ObjY, usrLyrObj,ch,textOrientation,pen,,1,,,nothing)
End Function
